home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / perl5 / URI / data.pm < prev    next >
Text File  |  2008-04-02  |  3KB  |  141 lines
  1. package URI::data;  # RFC 2397
  2.  
  3. require URI;
  4. @ISA=qw(URI);
  5.  
  6. use strict;
  7.  
  8. use MIME::Base64 qw(encode_base64 decode_base64);
  9. use URI::Escape  qw(uri_unescape);
  10.  
  11. sub media_type
  12. {
  13.     my $self = shift;
  14.     my $opaque = $self->opaque;
  15.     $opaque =~ /^([^,]*),?/ or die;
  16.     my $old = $1;
  17.     my $base64;
  18.     $base64 = $1 if $old =~ s/(;base64)$//i;
  19.     if (@_) {
  20.     my $new = shift;
  21.     $new = "" unless defined $new;
  22.     $new =~ s/%/%25/g;
  23.     $new =~ s/,/%2C/g;
  24.     $base64 = "" unless defined $base64;
  25.     $opaque =~ s/^[^,]*,?/$new$base64,/;
  26.     $self->opaque($opaque);
  27.     }
  28.     return uri_unescape($old) if $old;  # media_type can't really be "0"
  29.     "text/plain;charset=US-ASCII";      # default type
  30. }
  31.  
  32. sub data
  33. {
  34.     my $self = shift;
  35.     my($enc, $data) = split(",", $self->opaque, 2);
  36.     unless (defined $data) {
  37.     $data = "";
  38.     $enc  = "" unless defined $enc;
  39.     }
  40.     my $base64 = ($enc =~ /;base64$/i);
  41.     if (@_) {
  42.     $enc =~ s/;base64$//i if $base64;
  43.     my $new = shift;
  44.     $new = "" unless defined $new;
  45.     my $uric_count = _uric_count($new);
  46.     my $urienc_len = $uric_count + (length($new) - $uric_count) * 3;
  47.     my $base64_len = int((length($new)+2) / 3) * 4;
  48.     $base64_len += 7;  # because of ";base64" marker
  49.     if ($base64_len < $urienc_len || $_[0]) {
  50.         $enc .= ";base64";
  51.         $new = encode_base64($new, "");
  52.     } else {
  53.         $new =~ s/%/%25/g;
  54.     }
  55.     $self->opaque("$enc,$new");
  56.     }
  57.     return unless defined wantarray;
  58.     $data = uri_unescape($data);
  59.     return $base64 ? decode_base64($data) : $data;
  60. }
  61.  
  62. # I could not find a better way to interpolate the tr/// chars from
  63. # a variable.
  64. my $ENC = $URI::uric;
  65. $ENC =~ s/%//;
  66.  
  67. eval <<EOT; die $@ if $@;
  68. sub _uric_count
  69. {
  70.     \$_[0] =~ tr/$ENC//;
  71. }
  72. EOT
  73.  
  74. 1;
  75.  
  76. __END__
  77.  
  78. =head1 NAME
  79.  
  80. URI::data - URI that contains immediate data
  81.  
  82. =head1 SYNOPSIS
  83.  
  84.  use URI;
  85.  
  86.  $u = URI->new("data:");
  87.  $u->media_type("image/gif");
  88.  $u->data(scalar(`cat camel.gif`));
  89.  print "$u\n";
  90.  open(XV, "|xv -") and print XV $u->data;
  91.  
  92. =head1 DESCRIPTION
  93.  
  94. The C<URI::data> class supports C<URI> objects belonging to the I<data>
  95. URI scheme.  The I<data> URI scheme is specified in RFC 2397.  It
  96. allows inclusion of small data items as "immediate" data, as if it had
  97. been included externally.  Examples:
  98.  
  99.   data:,Perl%20is%20good
  100.  
  101.   data:image/gif;base64,R0lGODdhIAAgAIAAAAAAAPj8+CwAAAAAI
  102.     AAgAAAClYyPqcu9AJyCjtIKc5w5xP14xgeO2tlY3nWcajmZZdeJcG
  103.     Kxrmimms1KMTa1Wg8UROx4MNUq1HrycMjHT9b6xKxaFLM6VRKzI+p
  104.     KS9XtXpcbdun6uWVxJXA8pNPkdkkxhxc21LZHFOgD2KMoQXa2KMWI
  105.     JtnE2KizVUkYJVZZ1nczBxXlFopZBtoJ2diXGdNUymmJdFMAADs=
  106.  
  107.  
  108.  
  109. C<URI> objects belonging to the data scheme support the common methods
  110. (described in L<URI>) and the following two scheme-specific methods:
  111.  
  112. =over 4
  113.  
  114. =item $uri->media_type( [$new_media_type] )
  115.  
  116. Can be used to get or set the media type specified in the
  117. URI.  If no media type is specified, then the default
  118. C<"text/plain;charset=US-ASCII"> is returned.
  119.  
  120. =item $uri->data( [$new_data] )
  121.  
  122. Can be used to get or set the data contained in the URI.
  123. The data is passed unescaped (in binary form).  The decision about
  124. whether to base64 encode the data in the URI is taken automatically,
  125. based on the encoding that produces the shorter URI string.
  126.  
  127. =back
  128.  
  129. =head1 SEE ALSO
  130.  
  131. L<URI>
  132.  
  133. =head1 COPYRIGHT
  134.  
  135. Copyright 1995-1998 Gisle Aas.
  136.  
  137. This library is free software; you can redistribute it and/or
  138. modify it under the same terms as Perl itself.
  139.  
  140. =cut
  141.